MacTech 1 to 12/MacTech-vol-1-12.toast/Source/Peter Lewis (TCPExample)/PNL Libraries/MyMemory.p

Text File | 1995-11-08 | 4.0 KB | 187 lines | [TEXT/CWIE]

unit MyMemory;

interface

    uses
        Types;

    function MNewPtr (var p: univ ptr; size: longint): OSErr;
    function MNewHandle (var hhhh: univ handle; size: longint): OSErr;
    function MSetPtrSize (var p: univ ptr; size: longint): OSerr;
    function MSetHandleSize (var hhhh: univ handle; size: longint): OSerr;
    procedure MDisposePtr (var p: univ ptr);
    procedure MDisposeHandle (var hhhh: univ handle);
    function MMungerInsert(data: Handle; offset: longint; ptr2: univ Ptr; len2: longint): OSErr;
    procedure MMungerDelete(data: Handle; offset: longint; len1: longint);
    procedure MZero (p: univ ptr; size: longint);
    procedure MFill (p: univ ptr; size: longint; val: integer);
    procedure MFillLong (p: univ ptr; size: longint; val: longint);
{ ptr and size must be long alligned }
    procedure LockHigh (hhhh: univ handle);
    procedure HLockState (hhhh: handle; var state: SignedByte);
    procedure HUnlockState (hhhh: handle; var state: SignedByte);
    procedure TrashPtr (data: Ptr);
    procedure TrashHandle (hhhh: handle);

implementation

    uses
        Memory, TextUtils;

{$SETC debug_memory=0 }

    const
        fill_byte = $E5; { odd, big, negative, easily recognizable }

    function CheckPtr (p: ptr): boolean;
    begin
{$IFC debug_memory }
        if p = nil then begin
            DebugStr('Memory Error!');
        end;
{$ENDC}
        CheckPtr := p <> nil;
    end;

    function MNewPtr (var p: univ ptr; size: longint): OSErr;
        var
            err: OSErr;
    begin
        p := NewPtr(size);
        err := MemError;
{$IFC debug_memory }
        if (err = noErr) then begin
            MFill(p, GetPtrSize(p), fill_byte);
        end;
{$ENDC}
        MNewPtr := err;
    end;

    function MNewHandle (var hhhh: univ handle; size: longint): OSErr;
        var
            err: OSErr;
    begin
        hhhh := NewHandle(size);
        err := MemError;
{$IFC debug_memory }
        if (err = noErr) then begin
            MFill(hhhh^, GetHandleSize(hhhh), fill_byte);
        end;
{$ENDC}
        MNewHandle := err;
    end;

    function MSetPtrSize (var p: univ ptr; size: longint): OSerr;
    begin
        SetPtrSize(p, size);
        MSetPtrSize := MemError;
    end;

    function MSetHandleSize (var hhhh: univ handle; size: longint): OSerr;
    begin
        SetHandleSize(hhhh, size);
        MSetHandleSize := MemError;
    end;

    procedure MDisposePtr (var p: univ ptr);
    begin
        if p <> nil then begin
{$IFC debug_memory }
            MFill(p, GetPtrSize(p), fill_byte);
{$ENDC}
            DisposePtr(p);
            p := nil;
        end;
    end;

    procedure MDisposeHandle (var hhhh: univ handle);
    begin
        if hhhh <> nil then begin
{$IFC debug_memory }
            MFill(hhhh^, GetHandleSize(hhhh), fill_byte);
{$ENDC}
            DisposeHandle(hhhh);
            hhhh := nil;
        end;
    end;

    procedure MZero (p: univ ptr; size: longint);
    begin
        MFill(p, size, 0);
    end;

    procedure MFill (p: univ ptr; size: longint; val: integer);
        var
            i: longint;
    begin
        if CheckPtr(p) then begin
            for i := longint(p) to longint(p) + size - 1 do begin
                ptr(i)^ := val;
            end;
        end;
    end;

    procedure MFillLong (p: univ ptr; size: longint; val: longint);
        type
            longPtr = ^longint;
        var
            i: longint;
    begin
        if CheckPtr(p) then begin
            i := longint(p);
            while size > 3 do begin
                longPtr(i)^ := val;
                i := i + 4;
                size := size - 4;
            end;
        end;
    end;

    procedure LockHigh (hhhh: univ handle);
    begin
        MoveHHi(hhhh);
        HLock(hhhh);
    end;

    procedure HLockState (hhhh: handle; var state: SignedByte);
    begin
        state := HGetState(hhhh);
        HLock(hhhh);
    end;

    procedure HUnlockState (hhhh: handle; var state: SignedByte);
    begin
        state := HGetState(hhhh);
        HUnlock(hhhh);
    end;

    procedure TrashPtr (data: Ptr);
    begin
        if (data <> nil) then begin
            MFill(data, GetPtrSize(data), fill_byte);
        end;
    end;

    procedure TrashHandle (hhhh: handle);
    begin
        if (hhhh <> nil) & (hhhh^ <> nil) then begin
            MFill(hhhh^, GetHandleSize(hhhh), fill_byte);
        end;
    end;

    function MMungerInsert(data: Handle; offset: longint; ptr2: univ Ptr; len2: longint): OSErr;
        var
            junk_long: longint;
    begin
        junk_long := Munger(data, offset, nil, 0, ptr2, len2);
        MMungerInsert := MemError;
    end;

    procedure MMungerDelete(data: Handle; offset: longint; len1: longint);
        var
            junk_long: longint;
    begin
        junk_long := Munger(data, offset, nil, len1, @junk_long, 0);
    end;

end.